home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 January - Disc 2 / Macworld (1999-01) (Disk 2).dmg / Serious Demos / Symbolic Composer 4.2 / Environment / Projects / Testers / Solar System Tester < prev    next >
Lisp/Scheme  |  1998-10-26  |  2KB  |  73 lines
  1. ;;; Solar Theme Example
  2.  
  3. (def-solar sun
  4.   (dates                    ; rotation speed
  5.     (mercurius 0 59 0 0 0)
  6.     (venus 0 244.3 0 0 0)
  7.     (earth 0 0 23 56 4.1)
  8.     (mars 0 0 24 37 22.6)
  9.     (jupiter 0 0 9 50 0)
  10.     (saturnus 0 0 10 40 0)
  11.     (uranus 0 0 12 0 0)
  12.     (neptunus 0 0 15 48 0)
  13.     (pluto 0 0 6 9 17))
  14.   (cycles                   ; now define year length
  15.     (mercurius 0 87.96 0 0 0)
  16.     (venus 0 224.68 0 0 0)
  17.     (earth 1 0 0 0 0)
  18.     (mars 0 686.95 0 0 0)
  19.     (jupiter 11.862 0 0 0 0)
  20.     (saturnus 29.456 0 0 0 0)
  21.     (uranus 84.07 0 0 0 0)
  22.     (neptunus 164.81 0 0 0 0)
  23.     (pluto 248.53 0 0 0 0))
  24.   (location                 ; and relative location to sun
  25.     (mercurius 1 0 0 0 0)   ; note that you can express any
  26.     (venus 2 0 0 0 0)       ; values here using just a one
  27.     (earth 3 0 0 0 0)       ; parameter and set others as zero
  28.     (mars 4 0 0 0 0)
  29.     (jupiter 5 0 0 0 0)
  30.     (saturnus 6 0 0 0 0)
  31.     (uranus 7 0 0 0 0)
  32.     (neptunus 8 0 0 0 0)
  33.     (pluto 9 0 0 0 0)))
  34.  
  35. ; waves seen on jupiter
  36.  
  37. (setq waveform 
  38.   (gen-fourier 
  39.    (gen-solar sun cycles jupiter
  40.          mercurius venus earth mars jupiter saturnus uranus neptunus) 
  41.    (reverse 
  42.       (gen-solar sun location jupiter
  43.          mercurius venus earth mars jupiter saturnus uranus neptunus))
  44.    '(0 0 0 0 0 0 0 0 0)
  45.    512))
  46.  
  47. (def-symbol
  48.    piano (vector-to-symbol a h waveform)
  49. )
  50.  
  51. (def-velocity
  52.    piano (vector-round 40 127 waveform)
  53. )
  54.  
  55. (def-tonality
  56.     piano (activate-tonality (pentatonic c 4))
  57. )
  58.  
  59. (def-length
  60.     piano '(1/16)
  61. )
  62.  
  63. (def-zone
  64.     piano (* 512 (get-tick '1/16))
  65. )
  66.  
  67. (midiport :printer)
  68.  
  69. (def-tempo 120)
  70.  
  71. (compile-instrument-p "ccl;output:" "Solar Song"
  72.   piano
  73. )